home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / OBJ1_2.ZIP;1 / C_REPORT.PRG < prev    next >
Encoding:
Text File  |  1993-01-21  |  15.5 KB  |  432 lines
  1. //*****************************************************************************
  2. // C_Report.prg
  3. // Report class for OBJECT v2.03
  4. // Copyright (c) 1991, JHK, JHK-Software, Piestany
  5. // Please compile with: /N/M/W/A
  6. //-----------------------------------------------------------------------------
  7.  
  8. #include "Error.ch"
  9. #include "InKey.ch"
  10. #include "Object.ch"
  11.  
  12. #define LenSp 2  //spaces beetwen report fields
  13.  
  14. create class Report from DBrowse
  15.   export:
  16.   var FName      // ""            //file name for this report,
  17.   var Handle     // -1            //and its handle; default: output file not created (opened)
  18.   var Width      // 0             //report (paper) width
  19.   var TopText    // ""            //"top_line1;line2;.."
  20.   var Fields     // {}            //{{cTitle,cField,cPicture,lTotal,cSubTotal},...}
  21.   var FSizes     // {}            //paralel array sizes of fields for report, see VProcess()
  22.   var Totals     // {}            //paralel array totals for each field:{{nTotal,nSubTotal},...}
  23.   var BottomText // ""            //"bottom_line1;line2;..."
  24.   var OnlyTotals // false         //to report only totals and subtotals
  25.   var OldOrder   // 0             //last controlling index order
  26.   method New=ReportNew                  //o:New()
  27.   method Init=ReportInit                //o:Init(Name,R,C,Rs,Cs,Clr,Shadow)
  28.   method AddData=ReportAddData          //o:AddData(cTop,aFields,cBottom,lOnlyTotals)
  29.   method AddTop=ReportAddTop            //o:AddTop(cTop)
  30.   method AddField=ReportAddField        //o:AddField(cTitle,cField,cPicture,lTotal,cSubTotal)
  31.   method AddBottom=ReportAddBottom      //o:AddBottom(cBottom)
  32.   method VPaint=ReportVPaint            //o:VPaint()
  33.   method VProcess=ReportVProcess        //o:VProcess()
  34.   endclass
  35.  
  36.  
  37. //*****************************************************************************
  38. // Report:New() --> self
  39. // initialize new object
  40. //
  41. constructor ReportNew()
  42.   ::FName:= ""
  43.   ::Handle:= -1
  44.   ::Width:= 0
  45.   ::TopText:= ""
  46.   ::Fields:= {}
  47.   ::FSizes:= {}
  48.   ::Totals:= {}
  49.   ::BottomText:= ""
  50.   ::OnlyTotals:=false
  51.   ::OldOrder:= 0
  52.   ::InfoBlock:= {|o|nil}
  53.   ::DoneBlock:= {|o|DoDone(o)}
  54.   return(self)
  55.  
  56.  
  57. //-----------------------------------------------------------------------------
  58. // Report::DoInfo() --> true
  59. // show CurRec,Index,Filter information
  60. //
  61. static function DoInfo(Report)
  62.   Report:InfoMsg:=" "+ResTxt(052)+"="+NTrim(RecNo())+"/"+NTrim(LastRec())+;
  63.                   " "+ResTxt(053)+"="+NTrim(IndexOrd())+;
  64.                   " "+ResTxt(054)+"="+NTrim(Report:FilterNo)+" "
  65.   Report:DoInfo()
  66.   return(true)
  67.  
  68.  
  69. //-----------------------------------------------------------------------------
  70. // Report::DoDone() --> true/false
  71. // conditional terminate this report
  72. //
  73. static function DoDone(Report)
  74.   if Report:Handle==-1; return(true); endif
  75.   if Alert(ResTxt(088),ResTxt(123))<>1; return(false); endif  //continue
  76.   begin break
  77.     FClose(Report:Handle)
  78.     FErase(Report:FName)
  79.     FErase(cTempFile+".ntx")
  80.   end break
  81.   return(true)
  82.  
  83.  
  84. //*****************************************************************************
  85. // Report:Init(Name,R,C,Rs,Cs,Clr,Shadow) --> true
  86. // initialize the report window
  87. //
  88. method function ReportInit(Name,R,C,Rs,Cs,Clr,Shadow)
  89.   default Rs to 1
  90.   default Cs to Min(MaxCol()-4,Max(Len(ResTxt(081))+6,Len(if(ValType(Name)=="C",Name,Eval(Name)))+10))
  91.   default R to Int((MaxRow()-Rs)/2)
  92.   default C to Int((MaxCol()-Cs)/2)
  93.   if( Cs<36, Cs:=36, )
  94.   ::MaxRows:=Rs
  95.   ::MaxCols:=Cs
  96.   return(::super(DBrowse):Init(Name,R,C,Rs,Cs,Clr,Shadow))
  97.  
  98.  
  99. //*****************************************************************************
  100. // Report:AddData(cTop,aFields,cBottom,lOnlyTotals) --> true
  101. // save complete report info
  102. //
  103. method function ReportAddData(cTop,aFields,cBottom,lOnlyTotals)
  104.   default cTop:=""
  105.   default cBottom:=""
  106.   default lOnlyTotals:=false
  107.   ::TopText:=cTop
  108.   ::Fields:=AClone(aFields)
  109.   ::BottomText:=cBottom
  110.   ::OnlyTotals:=lOnlyTotals
  111.   return(true)
  112.  
  113.  
  114. //*****************************************************************************
  115. // Report:AddTop(cTop) --> true
  116. // save top lines
  117. //
  118. method function ReportAddTop(cTop)
  119.   ::TopText:=cTop
  120.   return(true)
  121.  
  122.  
  123. //*****************************************************************************
  124. // Report:AddField(cTitle,cField,cPicture,lTotal,cSubTotal) --> true
  125. // save top lines
  126. //
  127. method function ReportAddField(cTitle,cField,cPicture,lTotal,cSubTotal)
  128.   default cTitle to cField
  129.   AAdd(::Fields,{cTitle,cField,cPicture,lTotal,cSubTotal})
  130.   return(true)
  131.  
  132.  
  133. //*****************************************************************************
  134. // Report:AddBottom(cBottom) --> true
  135. // save bottom lines
  136. //
  137. method function ReportAddBottom(cBottom)
  138.   ::BottomText:=cBottom
  139.   return(true)
  140.  
  141.  
  142. //*****************************************************************************
  143. // Report:VPaint() --> true
  144. // paint please wait... message
  145. //
  146. method function ReportVPaint()
  147.   @ ::Row+1,::Col+4 say ResTxt(081) color ::Color
  148.   Eval(::InfoBlock,self)
  149.   return(true)
  150.  
  151.  
  152. //*****************************************************************************
  153. // Report:VProcess() --> Report/FInfo object
  154. // main report method, output data into disk file
  155. //
  156. method function ReportVProcess()
  157.   local Top,Bottom,FInfo
  158.   local Values:={}              //current field values for output
  159.   local aSubTotal,ee,i          //work info array of needed subtotals, ee,i=working for block in block problem
  160.   local Oe                      //clipper error object
  161.   local OutTask:=self           //may be changed onto FInfo
  162.   SaveDOut(ResTxt(145))
  163.   SaveHelpIdx({1})
  164.   ::UpDatabase()                //set up good database
  165.   begin break                   //keep disk errors
  166.     if ::Handle==-1
  167.       if CreateFile(self)==-1   //disk error
  168.         Alert(ResTxt(090))
  169.         break
  170.       endif
  171.       if !AddIndex(self)
  172.         Oe:=ErrorNew()
  173.         Oe:Severity:=ES_ERROR
  174.         Oe:SubSystem:="Object/Report"
  175.         Oe:Description:="Can't create index file"
  176.         Oe:FileName:=cTempFile
  177.         break Oe
  178.       endif
  179.       go top                                    //make sure for top of database
  180.       Top:=ListAsArray(::TopText,";")
  181.       Bottom:=ListAsArray(::BottomText,";")
  182.       ::Width:=0
  183.       ::FSizes:=Array(Len(::Fields))
  184.       AEval(::Fields,{|e,i|::Width+=(::FSizes[i]:=Max(Len(e[1]),Len(Transform(&(e[2]),e[3]))))+LenSp})
  185.       ::Width-=LenSp
  186.       ::Width:=Max(::Width,AWidth(Top))
  187.       ::Width:=Max(::Width,AWidth(Bottom))
  188.       *
  189.       FWrite(::Handle,Replicate(chr(240),::Width-Len(ResTxt(086))-5)+" "+ResTxt(086)+" "+Replicate(chr(240),3)+cr_lf)
  190.       if !Empty(Top)
  191.         AEval(Top,{|e|FWrite(::Handle,PadC(e,::Width)+cr_lf)})                       //out header
  192.         FWrite(::Handle,Replicate("=",::Width)+cr_lf)                                //underline
  193.       endif
  194.       AEval(::Fields,{|e,i|FWrite(::Handle,PadR(e[1],::FSizes[i])+Space(LenSp))})    //title of fields
  195.       FWrite(::Handle,cr_lf)                                                         //new line for end of titles
  196.       AEval(::FSizes,{|e|FWrite(::Handle,Replicate("=",e)+Space(LenSp))})            //titles underline
  197.       FWrite(::Handle,cr_lf)                                                         //new line for end of underline
  198.       *
  199.       if AScan(::Fields,{|e|e[4]})>0           //is any total?
  200.         ::Totals:=Array(Len(::Fields),2)
  201.         AEval(::Fields,{|e,i|::Totals[i,1]:=if(!Empty(e[4]),0,nil),::Totals[i,2]:=if(!Empty(e[5]),0,nil)})
  202.       endif
  203.       ::InfoBlock:={|o|DoInfo(o)}   //#show CurRec,Index,Filter
  204.     endif
  205.     *--------------------------------------------------------------------------
  206.     repeat  //DbEval loop
  207.       DoInfo(self)
  208.       Values:={}                                         //clear
  209.       AEval(::Fields,{|e|AAdd(Values,&(e[2]))})          //load current values
  210.       skip                                               //future values
  211.       AEval(::Fields,{|e,i|OutField(self,i,Values[i])})  //output field
  212.       if( !::OnlyTotals, FWrite(::Handle,cr_lf), )       //new line (field or subtotal)
  213.       aSubTotal:={}
  214.       AEval(::Fields,{|e,i|ee:=e,AAdd(aSubTotal,TestSubTotal(self,Values,i,AScan(::Fields,{|x|x[2]==ee[5]})) )})
  215.       if AScan(aSubTotal,{|e|e[1]>0})>0
  216.         if !::OnlyTotals
  217.           AEval(aSubTotal,{|e,i|OutSubTotal(self,i,if(e[1]==0," ","-"),3)})
  218.           FWrite(::Handle,cr_lf)
  219.         endif
  220.         for i:=1 to Len(aSubTotal)
  221.           if aSubtotal[i,1]>0
  222.             OutSubTotal(self,i,i,1)
  223.           else
  224.             if ::OnlyTotals and AScan(aSubTotal,{|w|i==w[2]})>0
  225.               OutSubTotal(self,i,Values[i],2)
  226.             else
  227.               OutSubTotal(self,i," ",3)
  228.             endif
  229.           endif
  230.         endfor
  231.         FWrite(::Handle,cr_lf)
  232.         if( !::OnlyTotals, FWrite(::Handle,cr_lf), )
  233.       endif
  234.     until Eof() or PauseKey()==nSwapTask
  235.     *--------------------------------------------------------------------------
  236.     if Eof()
  237.       if !Empty(::Totals)
  238.         AEval(::FSizes,{|e|FWrite(::Handle,Replicate("=",e)+Space(LenSp))})
  239.         FWrite(::Handle,cr_lf)
  240.         AEval(::Totals,{|e,i|FWrite(::Handle,PadL(if(e[1]==nil," ",NTrim(e[1])),::FSizes[i])+Space(LenSp))})
  241.         FWrite(::Handle,cr_lf)
  242.       endif
  243.       if !Empty(Bottom)
  244.         FWrite(::Handle,Replicate("=",::Width)+cr_lf)              //underline
  245.         AEval(Bottom,{|e|FWrite(::Handle,PadC(e,::Width)+cr_lf)})  //out footnote
  246.       endif
  247.       FWrite(::Handle,Replicate(chr(240),::Width-Len(ResTxt(087))-5)+" "+ResTxt(087)+" "+Replicate(Chr(240),3)+cr_lf)
  248.       FClose(::Handle)
  249.       ::Handle:=-1
  250.       DelIndex(self)
  251.       ::Done()      //dead parent task
  252.       *
  253.       object FInfo of FInfo
  254.       if FInfo:Init(::FName,::Name)
  255.         FInfo:DoneBlock:={|o|DoneViewReport(o)}
  256.         FInfo:Wrap:=false
  257.         FInfo:CanErase:=true
  258.         FInfo:Paint()
  259.         SetLastKey(K_ENTER)
  260.         OutTask:=FInfo        //child task continued without parent task
  261.       else
  262.         Alert(ResTxt(094))
  263.       endif
  264.       *
  265.     endif
  266.   recover break using Oe
  267.     if Oe<>nil
  268.       if Empty(Oe:FileName); Eval(ErrorBlock(),Oe); endif  //no disk error!
  269.       Alert(ResTxt(089)+";"+ErrorMessage(Oe))
  270.       begin break
  271.         FClose(::Handle)
  272.         FErase(::FName)
  273.       end break
  274.     endif
  275.     ::Handle:=-1
  276.     ::Done()
  277.     SetLastKey(nSwapTask)  //need for task class
  278.   end break
  279.   ::RecNo:=RecNo()
  280.   RestHelpIdx()
  281.   RestDOut()
  282.   return(OutTask)
  283.  
  284.  
  285. //-----------------------------------------------------------------------------
  286. // Report::AddIndex() --> true/false
  287. // create new need index for subtotals, save old index info
  288. // see UpDatabase()
  289. //
  290. static function AddIndex(Report)
  291.   local OneDbf,i
  292.   local c:=GetNewIndex(Report)    //new index expression (as string)
  293.   Report:OldOrder:=IndexOrd()     //save last order
  294.   if !Empty(c)
  295.     i:=1
  296.     while !Empty(IndexKey(i)) and !(IndexKey(i)==c); i++; endwhile   //is the index in list of active indexes
  297.     if !(IndexKey(i)==c)
  298.       if !Empty(IndexKey())
  299.         c+="+"+Stringify(IndexKey())
  300.       endif
  301.       OneDbf:=CopyOneDbf(Alias())   //get current (alias) database definition
  302.       i:=Len(OneDbf:Ntx)+1          //new index order
  303.       OneDbf:AddNtx(,cTempFile,c)
  304.       if !OneDbf:NtxOpen(); return(false); endif
  305.     endif
  306.     DbSetOrder(i)
  307.   endif
  308.   return(true)
  309.  
  310.  
  311. //-----------------------------------------------------------------------------
  312. // Report::GetNewIndex() --> cNewIndexKey
  313. // create new need index key (as string)
  314. //
  315. static function GetNewIndex(Report)
  316.   local c:=""
  317.   AEval(Report:Fields,{|e|if(e[5]<>nil,c+="+"+Stringify(e[5]),nil)})
  318.   return(SubStr(c,2))
  319.  
  320.  
  321. static function Stringify(Field)    //cFieldName
  322.   local cC:=ValType(&(Field))
  323.   do case
  324.     case cC=="M"; return(Field)
  325.     case cC=="C"; return(Field)
  326.     case cC=="D"; return("DTOS("+Field+")")
  327.     case cC=="N"; return("STR("+Field+")")
  328.     case cC=="L"; return("IF("+Field+",'.T.','.F.')")
  329.   endcase
  330.   return(true)
  331.  
  332.  
  333. //-----------------------------------------------------------------------------
  334. // Report::DelIndex() --> true
  335. // restore original index system
  336. //
  337. static function DelIndex(Report)
  338.   local OneDbf:=GetOneDbf(Alias())    //get current (alias) database definition
  339.   OneDbf:NtxOpen(false)
  340.   DbSetOrder(Report:OldOrder)
  341.   NetFErase(cTempFile+".ntx",true)
  342.   return(true)
  343.  
  344.  
  345. //-----------------------------------------------------------------------------
  346. //-----------------------------------------------------------------------------
  347. // Report::OutField(i,xValue) --> true
  348. // output one field of line of report
  349. //
  350. static function OutField(Report,i,xValue)
  351.   local c
  352.   if !Report:OnlyTotals
  353.     c:=Transform(xValue,Report:Fields[i,3]) //picture transformation
  354.     c:=if(ValType(xValue)=="N", PadL(c,Report:FSizes[i]), PadR(c,Report:FSizes[i]))
  355.     FWrite(Report:Handle,c+Space(LenSp))  //out value
  356.   endif
  357.   if !Empty(Report:Totals)
  358.     if Report:Totals[i,1]<>nil; Report:Totals[i,1]+=xValue; endif  //total
  359.     if Report:Totals[i,2]<>nil; Report:Totals[i,2]+=xValue; endif  //subtotal
  360.   endif
  361.   return(true)
  362.  
  363.  
  364. //-----------------------------------------------------------------------------
  365. // Report::TestSubTotal(Values,i,j) --> i/0
  366. // output one field of line of report
  367. // i=field index into Report:Fields, this field has been sumarized
  368. // j=0 do not subtotal
  369. // j>0 and Values[j]<>FutureValue(Report:Fields[j,2]) do subtotal
  370. //
  371. static function TestSubTotal(Report,Values,i,j)
  372.   if j==0; return({0,0}); endif
  373.   if Values[j]==&(Report:Fields[j,2]); return({0,0}); endif
  374.   return({i,j})
  375.  
  376.  
  377. //-----------------------------------------------------------------------------
  378. // Report::OutSubTotal(Report,i,xValue,nMode) --> true
  379. // output one field of line of report
  380. // i=field index into Report:Fields, this field has been sumarized
  381. // xValue=" " in this time will be output spaces or
  382. // xValue="-" in this time will be only underlining
  383. // xValue=i   write Report:Totals[i,2]
  384. // nMode=1    output totals_number
  385. // nMode=2    output totals_field
  386. // nMode=3    output spaces or "-----"
  387. //
  388. static function OutSubTotal(Report,i,xValue,nMode)
  389.   local c
  390.   if nMode==1
  391.     c:=Transform(Report:Totals[i,2],Report:Fields[i,3])                   //picture transformation
  392.     FWrite(Report:Handle,PadL(AllTrim(c),Report:FSizes[i])+Space(LenSp))  //out value
  393.     Report:Totals[i,2]:=0                                                 //clear subtotal
  394.   elseif nMode==2
  395.     c:=Transform(xValue,Report:Fields[i,3])                               //picture transformation
  396.     FWrite(Report:Handle,PadL(AllTrim(c),Report:FSizes[i])+Space(LenSp))  //out value
  397.   else
  398.     FWrite(Report:Handle,Replicate(xValue,Report:FSizes[i])+Space(LenSp))
  399.   endif
  400.   return(true)
  401.  
  402.  
  403. //-----------------------------------------------------------------------------
  404. // Report::CreateFile() --> Handle
  405. // look for existing files and create new (unique) report file
  406. //
  407. static function CreateFile(Report)
  408.   Report:FName:=GetNewRepName()
  409.   Report:Handle:=FCreate(Report:FName)
  410.   return(Report:Handle)
  411.  
  412.  
  413. //-----------------------------------------------------------------------------
  414. // FInfo::DoneViewReport() --> true/false
  415. // selectable erasing report file
  416. //
  417. static function DoneViewReport(FInfo)
  418.   local Ch
  419.   FInfo:Top(false)
  420.   Ch:=Alert(ResTxt(091)+" "+FInfo:FName+";"+ResTxt(092),ResTxt(132))
  421.   do case
  422.     case Ch==1
  423.       FErase(FInfo:FName)
  424.       return(true)
  425.     case Ch==2
  426.       return(true)
  427.   endcase
  428.   return(false)   //dummy line
  429.  
  430. //------------------------------------------------------- eof (c)JHK ----------
  431.  
  432.